Imports System.IO

Partial Class _Default
    Inherits System.Web.UI.Page

    ' Function type
    Public Enum fnType
        ROAD_LEVEL
        PREMISE_LEVEL
        POSTZON
        CREDITS
    End Enum
    Public Enum outType
        XML
        JSON
    End Enum

    Private Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ' On Load, carry out action

        ' Check if running locally (for debugging)
        Dim bIsLocal As Boolean = HttpContext.Current.Request.Url.AbsoluteUri.StartsWith("http://localhost:")

        ' Set up database connection 
        Dim MyConn As OleDbConnection

        'Declare database connection variables
        Dim strConn As String = ConfigurationManager.ConnectionStrings("LocalConnectionString").ConnectionString
        MyConn = New OleDbConnection(strConn)

        ' Initialise
        Dim nErrNo As Integer = 0
        Dim sUser As String = "", sPassword As String = ""
        Dim func As fnType
        Dim frmOut As outType
        Dim sCallback As String = ""

        ' Initialise the address object
        Dim AddressObject As AddressUKNET.Address = New AddressUKNET.Address()
        Try
            AddressObject = New AddressUKNET.Address()
        Catch
            nErrNo = 104
        End Try

        Dim sDataPath As String = "C:\inetpub\vhosts\2676620.cust.peer1.com\bifrost\webservices\App_Data"
        If bIsLocal Then sDataPath = "C:\Address"
        If Not AddressObject.InitAddress(sDataPath) Then
            nErrNo = 100
        Else
            ' Read username, password and function input parameters
            nErrNo = ReadParams(sUser, sPassword, func, frmOut, sCallback)
        End If

        If nErrNo > 0 Then
            If frmOut = outType.XML Then
                XMLError(nErrNo)
            Else
                JSONError(nErrNo, sCallback)
            End If
            If Not AddressObject Is Nothing Then
                AddressObject.Close()
                AddressObject = Nothing
            End If
            Exit Sub
        End If

        'Connect to the Access database
        MyConn.Open()

        ' Check for valid user name & password
        nErrNo = IsUserValid(MyConn, sUser, sPassword)
        If nErrNo > 0 Then
            If frmOut = outType.XML Then
                XMLError(nErrNo)
            Else
                JSONError(nErrNo, sCallback)
            End If

            If Not MyConn Is Nothing Then MyConn.Close()
            If Not AddressObject Is Nothing Then
                AddressObject.Close()
                AddressObject = Nothing
            End If
            Exit Sub
        End If

        ' Get details of the record that will be debited for this action
        Dim nID As Int32
        Dim bNotify As Boolean
        nErrNo = CreditRecord(MyConn, sUser, sPassword, func, nID, bNotify)

        If nErrNo = 0 Then

            ' Perform the required action and output result
            nErrNo = DoAction(MyConn, AddressObject, func, frmOut, sUser, sPassword, sCallback)

            If nErrNo = 0 Then

                ' Increment clicks used in database
                Try
                    Dim MySQL As String = "UPDATE History SET ClicksUsed = ClicksUsed + 1 WHERE ID = " & nID.ToString()
                    Dim cmdUpdate As New OleDbCommand(MySQL, MyConn)
                    cmdUpdate.ExecuteNonQuery()
                    cmdUpdate.Dispose()

                Catch
                    ' Notify ourselves on error
                    Dim SmtpMail As New Net.Mail.SmtpClient
                    SmtpMail.Send("info@arcenciel.com", "info@arcenciel.com", "Per Click problem", "Click update failed for:" & sUser)
                End Try

            End If
        End If

        ' If there was a failure, output the error
        If (nErrNo > 0) Then
            If frmOut = outType.XML Then
                XMLError(nErrNo)
            Else
                JSONError(nErrNo, sCallback)
            End If
        End If

        ' Send warning email that clicks are low
        If bNotify Then SendEmail(MyConn, sUser, sPassword, func)

        'If the database is open, then close it
        If Not MyConn Is Nothing Then MyConn.Close()

        ' Destroy the Address object
        If Not AddressObject Is Nothing Then
            AddressObject.Close()
            AddressObject = Nothing
        End If


    End Sub

    Public Function DoAction(ByRef MyConn As OleDbConnection, ByRef AddressObject As AddressUKNET.Address, _
                    ByVal func As fnType, ByVal frmOut As outType, ByVal sUser As String, ByVal sPassword As String, _
                    ByVal sCallback As String) As Integer
        ' Carry out the operation specified
        ' Return: 0 - OK; 8 - No credits left; 9 - System error; 10 - Missing postcode; 11 - Invalid postcode; 
        '                 12 - Address system error, 13 - Only CB codes in testing

        ' Initialise
        Dim nErrNo As Integer = 0
        Dim aRoadData As ArrayList, aResPrem As ArrayList, aCommPrem As ArrayList
        aRoadData = New ArrayList()
        aResPrem = New ArrayList()
        aCommPrem = New ArrayList()

        ' Output credit information
        If func = fnType.CREDITS Then
            ListCredits(MyConn, sUser, sPassword)
        Else

            ' Load all address data
            Dim bTest As Boolean
            bTest = (sUser = "test" And sPassword = "password")
            Dim sAreaData As String = ""
            Dim sPostzon As String = ""
            nErrNo = LoadResults(AddressObject, bTest, func, sAreaData, aRoadData, aResPrem, aCommPrem, sPostzon)

            ' Output results
            If nErrNo = 0 Then
                If func = fnType.ROAD_LEVEL Or func = fnType.PREMISE_LEVEL Then

                    ' Return address information
                    If frmOut = outType.XML Then
                        XMLAddress(sAreaData, aRoadData, aResPrem, aCommPrem)
                    Else
                        JSONAddress(sAreaData, aRoadData, aResPrem, aCommPrem, sCallback)
                    End If

                ElseIf func = fnType.POSTZON Then

                    ' Return Postzon information
                    If frmOut = outType.XML Then
                        XMLPostzon(AddressObject, sPostzon)
                    Else
                        JSONPostzon(AddressObject, sPostzon)
                    End If

                End If
            End If
        End If

        ' Return status
        Return nErrNo

    End Function

    Public Function ReadParams(ByRef sUser As String, ByRef sPassword As String, ByRef func As fnType, _
                                ByRef frmOut As outType, ByRef sCallback As String) As Integer
        ' Parse input parameters
        ' Return: 0 - Success; 1 - Missing username; 2 - Missing password;  3 - Missing function; 5 - Invalid function

        ' Initialise
        Dim nStatus As Integer = 0
        sUser = ""
        sPassword = ""
        Dim sFunction As String = ""
        frmOut = outType.XML
        sCallback = ""

        ' Load optional output type
        Dim sOutput As String = ""
        sOutput = LCase(Request.QueryString("output"))
        If sOutput = "json" Then
            frmOut = outType.JSON
        ElseIf sOutput = "xml" Then
            frmOut = outType.XML
        End If

        ' Load optional callback function name
        If nStatus = 0 Then
            sCallback = Request.QueryString("callback")
        End If

        ' Load user ID
        sUser = Request.QueryString("user")
        If sUser = "" Then
            nStatus = 1
        Else
            ' Load password
            sPassword = Request.QueryString("password")
            If sPassword = "" Then
                nStatus = 2
            Else
                ' Load function
                sFunction = LCase(Request.QueryString("function"))

                ' Check function is valid
                If sFunction = "" Then
                    nStatus = 3
                ElseIf sFunction = "getroadaddress" Then
                    func = fnType.ROAD_LEVEL
                ElseIf sFunction = "getpremiseaddress" Then
                    func = fnType.PREMISE_LEVEL
                ElseIf sFunction = "getpostzon" Then
                    func = fnType.POSTZON
                ElseIf sFunction = "getcredit" Then
                    func = fnType.CREDITS
                Else
                    nStatus = 5
                End If
            End If
        End If

        ' Return status code
        Return nStatus

    End Function

    Public Function IsUserValid(ByRef MyConn As OleDbConnection, ByVal sUser As String, ByVal sPassword As String) As Integer
        ' Check if a user name/password is valid
        ' Return: 0 - OK; 4 - Not present; 101 - More than 1 present

        ' Initialise
        Dim nStatus As Integer = 0

        ' Count occurences of name/password in database
        Dim MySQL1 As String = "Select Count(*) FROM UserData WHERE UserName = '" & sUser & "' AND Password = '" & sPassword & "'"

        Dim cmdCount As New OleDbCommand(MySQL1, MyConn)
        Dim nPresent As Int32
        nPresent = Convert.ToInt32(cmdCount.ExecuteScalar())
        cmdCount.Dispose()

        ' Must be exactly one occurence
        If nPresent = 0 Then
            nStatus = 4
        ElseIf nPresent = 1 Then
            nStatus = 0
        Else
            nStatus = 101
        End If

        ' Return result
        Return nStatus

    End Function

    Public Sub ListCredits(ByRef MyConn As OleDbConnection, ByVal sUser As String, ByVal sPassword As String)
        ' List all credits for this user

        ' Initialise
        Dim sToday As String = DateTime.Now.ToString("MM/dd/yyyy")

        ' Get all non-expired, non-zero balances for this user
        Dim sql As String
        sql = "SELECT History.Type, History.ExpiryDate, History.UnlimitedClicks, History.ClicksPurchased, " + _
                    "History.ClicksUsed, History.Areas " + _
                    "FROM History INNER JOIN UserData ON UserData.ID = History.UserID " + _
                    "WHERE UserData.UserName = '" & sUser & "' AND UserData.Password = '" & sPassword & "' AND " + _
                    "ExpiryDate > #" + sToday + "# AND " + _
                    "((History.ClicksUsed < History.ClicksPurchased) OR History.UnlimitedClicks) ORDER BY History.Type"

        Dim cmd As New OleDbCommand(sql, MyConn)
        Dim list As OleDbDataReader = cmd.ExecuteReader()

        ' Write XML header
        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)
        With XmlWriter
            .WriteStartDocument()
            .WriteStartElement("Result")

            ' Loop through all credits
            Dim dtExpire As DateTime
            Dim nType As Integer, nCredit As Integer
            Dim bNoLimit As Boolean
            Dim sAreas As String = ""
            Do While list.Read

                ' Load type, expiry date, balance and Area limits
                nType = list.GetInt32(0)
                dtExpire = list.GetDateTime(1)
                bNoLimit = list.GetBoolean(2)
                nCredit = list.GetInt32(3) - list.GetInt32(4)
                If Not IsDBNull(list.Item(5)) Then
                    sAreas = list.GetString(5)
                Else
                    sAreas = ""
                End If

                ' Output a type record
                .WriteStartElement("Credit")
                Dim sType As String = ""
                If nType = 0 Then
                    sType = "Road level"
                ElseIf nType = 1 Then
                    sType = "Premise level"
                ElseIf nType = 2 Then
                    sType = "Postzon"
                End If
                .WriteElementString("Type", sType)
                .WriteElementString("Expiry", dtExpire.ToString("dd/MM/yyyy"))
                If bNoLimit Then
                    .WriteElementString("Balance", "Unlimited")
                Else
                    .WriteElementString("Balance", nCredit.ToString())
                End If
                If sAreas <> "" Then
                    .WriteElementString("Areas", sAreas)
                End If
                .WriteEndElement()

            Loop

            ' Write XML close
            .WriteEndElement()
            .WriteEndDocument()
            .Close()

        End With

        ' Clean up
        cmd.Dispose()

    End Sub

    Public Function CreditRecord(ByRef MyConn As OleDbConnection, ByVal sUser As String, ByVal sPassword As String, ByVal func As fnType, _
                                ByRef nID As Int32, ByRef bNotify As Boolean) As Integer
        ' Get a user purchase record from which a credit will be taken. Load record identifier and clicks used to date.
        ' NB Simply returns zero if function is credit check
        ' Return: 0 - OK, 6 - No credits left, 10 - Outside licensed Areas, 102 - System error

        ' Initialise
        Dim nErr As Integer = 0
        nID = 0
        Dim sAreas As String = ""
        Dim bUnlimited As Boolean = False
        bNotify = False
        Dim sToday As String = DateTime.Now.ToString("MM/dd/yyyy")
        Dim sFunc As String = ""
        Select Case func
            Case fnType.ROAD_LEVEL
                sFunc = "0"
            Case fnType.PREMISE_LEVEL
                sFunc = "1"
            Case fnType.POSTZON
                sFunc = "2"
            Case fnType.CREDITS
                sFunc = ""
            Case Else
                nErr = 102
        End Select

        ' Get all non-expired, non-zero balances for this user and for this type
        If nErr = 0 And sFunc <> "" Then
            Dim sql As String

            'Change date to American style
            'Dim newDate As String = convertDate(sToday)

            sql = "SELECT History.ID, History.Areas, (History.ClicksPurchased - History.ClicksUsed - History.Notify) As NotifyChk, " + _
                    "History.UnlimitedClicks " + _
                     "FROM History INNER JOIN UserData ON UserData.ID = History.UserID " + _
                     "WHERE UserData.UserName = '" & sUser & "' AND UserData.Password = '" & sPassword & "' AND " + _
                     "History.Type = " + sFunc + " AND ExpiryDate > #" + sToday + "# AND " + _
                     "((History.ClicksUsed < History.ClicksPurchased) OR History.UnlimitedClicks) " + _
                     "ORDER BY History.ExpiryDate"

            Dim cmd As New OleDbCommand(sql, MyConn)
            Dim list As OleDbDataReader = cmd.ExecuteReader()

            ' If no results, user has no credits left
            If Not list.HasRows() Then
                nErr = 6
            Else
                ' Load oldest or only record identifier for later updating
                list.Read()
                nID = list.GetInt32(0)                 ' Record ID

                ' Load postcode Area limits if any
                If Not IsDBNull(list.Item(1)) Then
                    sAreas = list.GetString(1)
                End If

                ' Check if we should send an email to say clicks low 
                If Not IsDBNull(list.Item(2)) Then
                    bNotify = (list.GetInt32(2) = 0)
                    If Not IsDBNull(list.Item(3)) Then
                        Dim bNoLimit As Boolean = False
                        bNoLimit = list.GetBoolean(3)
                        If bNoLimit Then bNotify = False
                    End If
                End If
            End If

            ' Apply postcode Area check
            If sAreas <> "" Then
                Dim sPostcode As String = Request.QueryString("postcode")
                If Not (sPostcode Is Nothing) Then
                    sPostcode = (sPostcode.Trim()).ToUpper()
                    If sPostcode.Length >= 5 Then
                        Dim sAreaCode As String = sPostcode.Substring(0, 2)
                        If Char.IsDigit(sAreaCode.Substring(1, 1)) Then sAreaCode = sPostcode.Substring(0, 1)
                        Dim aAreas As String() = sAreas.Split(",")
                        Dim bAreaOK As Boolean = False
                        Dim iArea As Integer
                        For iArea = 0 To aAreas.Length - 1
                            If aAreas(iArea) = sAreaCode Then
                                bAreaOK = True
                                Exit For
                            End If
                        Next
                        If Not bAreaOK Then nErr = 10
                    End If
                End If
            End If

            ' Clean up
            cmd.Dispose()
        End If

        ' Return result
        Return nErr

    End Function

    Public Function LoadResults(ByRef AddressObject As AddressUKNET.Address, ByVal bTest As Boolean, ByVal func As fnType, ByRef sAreaData As String, _
                                ByRef aRoadData As ArrayList, ByRef aResPrem As ArrayList, ByRef aCommPrem As ArrayList, ByRef sPostzon As String) As Integer
        ' Load address components
        ' Return 0 - OK; 7 - Missing postcode; 8 - Invalid postcode; 9 - Only CB codes in testing; 103 - Address system error

        ' Initialise
        Dim nErr As Integer = 0
        sAreaData = ""
        sPostzon = ""
        Dim nStatus As Integer = 0

        ' Load postcode and check it
        Dim sPostcodeP As String = "", sPostcode As String = ""
        If Request.QueryString("postcode") Is Nothing Then
            nErr = 7
        Else
            sPostcodeP = Request.QueryString("postcode")
            If sPostcodeP = "" Then
                nErr = 7
            Else
                AddressObject.FormatPostcode(sPostcodeP, sPostcode)
                If sPostcode.Length() < 5 Then
                    nErr = 8
                Else

                    ' Set notional cursor at postcode
                    nStatus = AddressObject.SeekPostcode(sPostcode)
                    If nStatus = 1 Or nStatus = 3 Then
                        nErr = 8
                    ElseIf nStatus <> 0 Then
                        nErr = 103
                        Dim SmtpMail As New Net.Mail.SmtpClient
                        SmtpMail.Send("info@arcenciel.com", "info@arcenciel.com", "Per Click problem", "Seek postcode failed on " & sPostcode)
                    End If

                    ' If testing, only CB1 - CB3 is permitted
                    If bTest Then
                        Dim sOutcode As String
                        sOutcode = sPostcode.Substring(0, sPostcode.Length - 3).ToUpper().Trim()
                        If (sOutcode.Length <> 3) Or (sOutcode < "CB1") Or (sOutcode > "CB3") Then
                            nErr = 9
                        End If
                    End If
                End If
            End If

        End If

        ' Notional cursor is positioned in the database - load the data
        If nErr = 0 Then

            ' Load address data into list arrays
            If func = fnType.ROAD_LEVEL Or func = fnType.PREMISE_LEVEL Then
                nStatus = LoadAddressData(AddressObject, func, sPostcode, sAreaData, aRoadData, aResPrem, aCommPrem)
                If nStatus <> 0 Then
                    nErr = 103
                    If nStatus = 1 Then
                        Dim SmtpMailA As New Net.Mail.SmtpClient
                        SmtpMailA.Send("info@arcenciel.com", "info@arcenciel.com", "Per Click problem", "Area data problem on " & sPostcode)
                    ElseIf nStatus = 2 Then
                        Dim SmtpMailR As New Net.Mail.SmtpClient
                        SmtpMailR.Send("info@arcenciel.com", "info@arcenciel.com", "Per Click problem", "Road data problem on " & sPostcode)
                    ElseIf nStatus = 3 Then
                        Dim SmtpMailR As New Net.Mail.SmtpClient
                        SmtpMailR.Send("info@arcenciel.com", "info@arcenciel.com", "Per Click problem", "Premise data problem on " & sPostcode)
                    End If
                End If

                ' Load postzon data
            ElseIf func = fnType.POSTZON Then
                If AddressObject.GetPostzonData(sPostzon) <> 0 Then
                    nErr = 103
                    Dim SmtpMailZ As New Net.Mail.SmtpClient
                    SmtpMailZ.Send("info@arcenciel.com", "info@arcenciel.com", "Per Click problem", "Postzon data problem on " & sPostcode)
                End If
            End If

        End If

        ' Return status
        Return nErr

    End Function

    Public Function LoadAddressData(ByRef AddressObject As AddressUKNET.Address, ByVal func As fnType, ByVal sPostcode As String, _
                                    ByRef sAreaData As String, ByRef aRoadData As ArrayList, ByRef aResPrem As ArrayList, _
                                    ByRef aCommPrem As ArrayList) As Integer
        ' Load thoroughfare and premise information from current cursor position - may be several for one postcode
        ' Return 0 - OK; 1 - Area data system error; 2 - road data system error; 3 - premise data system error

        ' Initialise
        Dim nErr As Integer = 0
        Dim sRoadData As String = "", sResPrem As String = "", sCommPrem As String = ""

        ' Load town/county data
        If AddressObject.GetAreaData(sAreaData) <> 0 Then
            nErr = 103
        End If

        ' Set up loop to allow for (rare) case of several roads per postcode
        Do
            ' Load thoroughfare data
            If AddressObject.GetRoadData(sRoadData) <> 0 Then
                nErr = 2
                Exit Do
            End If
            Dim Fields As String() = sRoadData.Split(",")

            ' Load premise data if required
            If func = fnType.PREMISE_LEVEL Or (func = fnType.ROAD_LEVEL And Fields(1) = "L") Then
                If AddressObject.GetPremiseData(True, sResPrem) <> 0 Then
                    nErr = 3
                    Exit Do
                End If
                If AddressObject.GetPremiseData(False, sCommPrem) <> 0 Then
                    nErr = 3
                    Exit Do
                End If
            End If

            ' If postcode has changed, exit the loop
            If Fields(0) <> sPostcode Then
                Exit Do
            End If

            ' Otherwise add data to lists 
            aRoadData.Add(sRoadData)
            aResPrem.Add(sResPrem)
            aCommPrem.Add(sCommPrem)

        Loop While AddressObject.SkipPAFRecord()

        ' Return status
        Return nErr

    End Function

    Public Sub XMLError(ByVal nErr As Integer)
        ' Output an XML file notifying an error
        ' Doesn't seem to work try: Response.Write("<html>" + nErr + "</html>")

        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)

        ' Write XML header
        With XmlWriter

            .WriteStartDocument()
            .WriteStartElement("Result")

            ' Output error code
            .WriteElementString("ErrCode", nErr.ToString())

            ' Output matching message
            Select Case nErr
                Case 1
                    .WriteElementString("ErrMessage", "Missing user name")

                Case 2
                    .WriteElementString("ErrMessage", "Missing password")

                Case 3
                    .WriteElementString("ErrMessage", "Missing function")

                Case 4
                    .WriteElementString("ErrMessage", "Invalid user name or password")

                Case 5
                    .WriteElementString("ErrMessage", "Invalid function")

                Case 6
                    .WriteElementString("ErrMessage", "No credit left for this function")

                Case 7
                    .WriteElementString("ErrMessage", "Missing postcode")

                Case 8
                    .WriteElementString("ErrMessage", "Invalid postcode")

                Case 9
                    .WriteElementString("ErrMessage", "Only codes starting with CB1-CB3 are allowed while testing")

                Case 10
                    .WriteElementString("ErrMessage", "Postcode outside licensed Areas")

                Case 100
                    .WriteElementString("ErrMessage", "System error: could not initialise addressing system")

                Case 101
                    .WriteElementString("ErrMessage", "System error: duplicate user")

                Case 102
                    .WriteElementString("ErrMessage", "System error: invalid credit check")

                Case 103
                    .WriteElementString("ErrMessage", "System error: error in addressing system")

                Case 104
                    .WriteElementString("ErrMessage", "System error: could not create addressing object")
            End Select

            ' Finish writing
            .WriteEndElement()
            .WriteEndDocument()
            .Close()

        End With

    End Sub

    Public Sub JSONError(ByVal nErr As Integer, ByVal sCallback As String)
        ' Output an JSON block notifying an error

        If String.IsNullOrEmpty(sCallback) Then sCallback = "LoadJSON"

        ' Create a TextWriter instance
        Response.ContentType = "application/json"
        Dim twsJSON As TextWriter = New StreamWriter(Response.OutputStream)

        ' Write opening lines
        With twsJSON
            .Write(sCallback + "(" + vbCrLf)
            .Write("{" + vbCrLf)
            .Write(" ""Results"":" + vbCrLf)
            .Write(" {" + vbCrLf)

            ' Output error code
            .Write(" ""ERRCODE"": """ + nErr.ToString() + """," + vbCrLf)

            ' Output error code and matching message
            Select Case nErr
                Case 1
                    .Write(" ""ERRMESSAGE"": ""Missing user name""" + vbCrLf)

                Case 2
                    .Write(" ""ERRMESSAGE"": ""Missing password""" + vbCrLf)

                Case 3
                    .Write(" ""ERRMESSAGE"": ""Missing function""" + vbCrLf)

                Case 4
                    .Write(" ""ERRMESSAGE"": ""Invalid user name or password""" + vbCrLf)

                Case 5
                    .Write(" ""ERRMESSAGE"": ""Invalid function""" + vbCrLf)

                Case 6
                    .Write(" ""ERRMESSAGE"": ""No credit left for this function""" + vbCrLf)

                Case 7
                    .Write(" ""ERRMESSAGE"": ""Missing function""" + vbCrLf)

                Case 8
                    .Write(" ""ERRMESSAGE"": ""Invalid postcode""" + vbCrLf)

                Case 9
                    .Write(" ""ERRMESSAGE"": ""Only codes starting with CB1-CB3 are allowed while testing""" + vbCrLf)

                Case 10
                    .Write(" ""ERRMESSAGE"": ""Postcode outside licensed Areas""" + vbCrLf)

                Case 100
                    .Write(" ""ERRMESSAGE"": ""System error: could not initialise addressing system""" + vbCrLf)

                Case 101
                    .Write(" ""ERRMESSAGE"": ""System error: duplicate user""" + vbCrLf)

                Case 102
                    .Write(" ""ERRMESSAGE"": ""System error: invalid credit check""" + vbCrLf)

                Case 103
                    .Write(" ""ERRMESSAGE"": ""System error: error in addressing system""" + vbCrLf)

                Case 104
                    .Write(" ""ERRMESSAGE"": ""System error: could not create addressing object""" + vbCrLf)
            End Select

            ' Finish writing
            .Write(" }" + vbCrLf)
            .Write(")" + vbCrLf)
            .Close()

        End With

    End Sub

    Public Sub XMLAddress(ByVal sAreaData As String, ByRef aRoadData As ArrayList, ByRef aResPrem As ArrayList, ByRef aCommPrem As ArrayList)
        ' Output an XML file of address details

        ' Initialise
        Dim nRoads As Integer = aRoadData.Count()
        Dim sRoadData As String = ""
        Dim sResPrem As String = ""
        Dim sCommPrem As String = ""

        ' Create a new XmlTextWriter instance
        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)

        ' Write XML header
        With XmlWriter

            .WriteStartDocument()
            If (nRoads > 1) Then .WriteStartElement("Results")

            ' Take data for each road (normally just one)
            Dim iRoad As Integer
            For iRoad = 0 To (nRoads - 1)
                sRoadData = aRoadData(iRoad)
                sResPrem = aResPrem(iRoad)
                sCommPrem = aCommPrem(iRoad)

                ' Parse data elements
                Dim fldsArea As String() = sAreaData.Split(",")
                Dim fldsRoad As String() = sRoadData.Split(",")
                Dim fldsRes As String() = sResPrem.Split(",")
                Dim fldsComm As String() = sCommPrem.Split(",")

                .WriteStartElement("Result")

                ' Output a label
                .WriteElementString("Label", MakeLabel(fldsArea, fldsRoad))

                ' Output Residential premise elements
                If sResPrem <> "" Then
                    If (fldsRes(4) <> "") Then .WriteElementString("NUM_R", fldsRes(4))
                    If (fldsRes(5) <> "") Then .WriteElementString("BNA_R", fldsRes(5))
                End If

                ' Output Non-Residential premise elements
                If sCommPrem <> "" Then
                    If (fldsComm(2) <> "") Then .WriteElementString("ORG", fldsComm(2))
                    If (fldsComm(3) <> "") Then .WriteElementString("POB", fldsComm(3))
                    If (fldsComm(4) <> "") Then .WriteElementString("NUM_N", fldsComm(4))
                    If (fldsComm(5) <> "") Then .WriteElementString("BNA_N", fldsComm(5))
                End If

                ' Large organisations have premise information in road record

                ' Output Street-level elements
                If (fldsRoad(3) <> "") Then .WriteElementString("DST", fldsRoad(3))
                If (fldsRoad(4) <> "") Then .WriteElementString("STR", fldsRoad(4))
                If (fldsRoad(5) <> "") Then .WriteElementString("DDL", fldsRoad(5))
                If (fldsRoad(6) <> "") Then .WriteElementString("DLO", fldsRoad(6))

                ' Output Area-level elements
                .WriteElementString("TWN", fldsArea(0))
                .WriteElementString("CTY", fldsArea(1))
                .WriteElementString("PCD", fldsRoad(0))
                .WriteEndElement()
            Next

            ' Finish writing
            If (nRoads > 1) Then .WriteEndElement()
            .WriteEndDocument()
            .Close()

        End With

    End Sub

    Public Sub JSONAddress(ByVal sAreaData As String, ByRef aRoadData As ArrayList, ByRef aResPrem As ArrayList, ByRef aCommPrem As ArrayList, _
                        ByVal sCallback As String)
        ' Output an JSON file of address details

        ' Initialise
        If String.IsNullOrEmpty(sCallback) Then sCallback = "LoadJSON"
        Dim nRoads As Integer = aRoadData.Count()
        Dim sRoadData As String = ""
        Dim sResPrem As String = ""
        Dim sCommPrem As String = ""

        ' Create a TextWriter instance
        Response.ContentType = "application/json"
        Dim twsJSON As TextWriter = New StreamWriter(Response.OutputStream)

        ' Write opening lines
        With twsJSON
            .Write(sCallback + "(" + vbCrLf)
            .Write("{" + vbCrLf)
            .Write(" ""Results"":" + vbCrLf)
            .Write(" {" + vbCrLf)
            .Write(" ""Result"":" + vbCrLf)
            .Write(" [" + vbCrLf)

            ' Take data for each road (normally just one)
            Dim iRoad As Integer
            For iRoad = 0 To (nRoads - 1)
                sRoadData = aRoadData(iRoad)
                sResPrem = aResPrem(iRoad)
                sCommPrem = aCommPrem(iRoad)

                ' Parse data elements
                Dim fldsArea As String() = sAreaData.Split(",")
                Dim fldsRoad As String() = sRoadData.Split(",")
                Dim fldsRes As String() = sResPrem.Split(",")
                Dim fldsComm As String() = sCommPrem.Split(",")

                .Write(" {" + vbCrLf)

                ' Output a label
                .Write(" ""Label"": """ + MakeLabel(fldsArea, fldsRoad) + """," + vbCrLf)

                ' Output Residential premise elements
                If sResPrem <> "" Then
                    If (fldsRes(4) <> "") Then .Write(" ""NUM_R"": """ + fldsRes(4) + """," + vbCrLf)
                    If (fldsRes(5) <> "") Then .Write(" ""BNA_R"": """ + fldsRes(5) + """," + vbCrLf)
                End If

                ' Output Non-Residential premise elements
                If sCommPrem <> "" Then
                    If (fldsComm(2) <> "") Then .Write(" ""ORG"": """ + fldsComm(2) + """," + vbCrLf)
                    If (fldsComm(3) <> "") Then .Write(" ""POB"": """ + fldsComm(3) + """," + vbCrLf)
                    If (fldsComm(4) <> "") Then .Write(" ""NUM_N"": """ + fldsComm(4) + """," + vbCrLf)
                    If (fldsComm(5) <> "") Then .Write(" ""BNA_N"": """ + fldsComm(5) + """," + vbCrLf)
                End If

                ' Large organisations have premise information in road record

                ' Output Street-level elements
                If (fldsRoad(3) <> "") Then .Write(" ""DST"": """ + fldsRoad(3) + """," + vbCrLf)
                If (fldsRoad(4) <> "") Then .Write(" ""STR"": """ + fldsRoad(4) + """," + vbCrLf)
                If (fldsRoad(5) <> "") Then .Write(" ""DDL"": """ + fldsRoad(5) + """," + vbCrLf)
                If (fldsRoad(6) <> "") Then .Write(" ""DDO"": """ + fldsRoad(6) + """," + vbCrLf)

                ' Output Area-level elements
                .Write(" ""TWN"": """ + fldsArea(0) + """," + vbCrLf)
                .Write(" ""CTY"": """ + fldsArea(1) + """," + vbCrLf)
                .Write(" ""PCD"": """ + fldsRoad(0) + """" + vbCrLf)

                If iRoad < (nRoads - 1) Then
                    .Write("  }," + vbCrLf)
                Else
                    .Write("  }" + vbCrLf)
                End If
            Next

            ' Finish writing
            .Write(" ]" + vbCrLf)
            .Write(" }" + vbCrLf)
            .Write("}" + vbCrLf)
            .Write(")" + vbCrLf)
            .Close()
        End With

    End Sub

    Public Function MakeLabel(ByVal fldsArea As String(), ByVal fldsRoad As String()) As String
        ' Construct a label suitable for an envelope

        ' Initialise
        Dim sLabel As String = ""

        ' Find if county is omitted yb convention
        Dim sCounty As String = fldsArea(1)
        If sCounty.Substring(0, 1) = "(" Then sCounty = ""

        ' Combine address elements to road level
        If (fldsRoad(3) <> "") Then sLabel = sLabel + fldsRoad(3) + ";"
        If (fldsRoad(4) <> "") Then sLabel = sLabel + fldsRoad(4) + ";"
        If (fldsRoad(5) <> "") Then sLabel = sLabel + fldsRoad(5) + ";"
        If (fldsRoad(6) <> "") Then sLabel = sLabel + fldsRoad(6) + ";"
        sLabel = sLabel + fldsArea(0).ToUpper() + ";"
        If (sCounty <> "") Then sLabel = sLabel + sCounty + ";"
        sLabel = sLabel + fldsRoad(0)

        ' If a Large organisation, premise information is present in road-level field
        Dim sPrem As String = ""
        If ((fldsRoad(1) <> "") Or (fldsRoad(2) <> "")) Then
            sPrem = fldsRoad(1)
            If ((sPrem <> "") And (fldsRoad(2) <> "")) Then sPrem += ";"
            sPrem += fldsRoad(2)
            PrefixPremise(sPrem, sLabel)
        End If

        ' Return result
        Return sLabel

    End Function

    Public Sub PrefixPremise(ByVal sPremise As String, ByRef sAddress As String)
        ' Prefix an address string with premise elements

        ' Validate
        Dim cbPremise As Integer = sPremise.Length
        If cbPremise < 1 Then Exit Sub
        Dim bNewLine As Boolean

        ' Check if last character is a number
        If Char.IsDigit(sPremise.Substring(cbPremise - 1, 1)) Then

            ' If a PO box add a newline
            If (sPremise.IndexOf("PO Box") >= 0) Then
                bNewLine = True

                ' Otherwise assume premise number and use a separating space
            Else
                bNewLine = False
            End If

            ' If penultimate character is a number, assume premise number
            ' such as '21B' and use a space
        ElseIf ((cbPremise > 1) And Char.IsDigit(sPremise.Substring(cbPremise - 2))) Then
            bNewLine = False

            ' Otherwise, introduce a newline
        Else
            bNewLine = True
        End If

        ' Join premise and road address with newline or space
        If bNewLine Then
            sAddress = sPremise + ";" + sAddress
        Else
            sAddress = sPremise + " " + sAddress
        End If

    End Sub

    Public Sub XMLPostzon(ByRef AddressObject As AddressUKNET.Address, ByVal sPostzon As String)
        ' Output an XML file of Postzon details 

        ' Create a new XmlTextWriter instance
        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)

        ' Write XML header
        With XmlWriter

            .WriteStartDocument()
            .WriteStartElement("Result")

            ' Split up data elements
            If sPostzon <> "" Then

                Dim fldsPostzon As String() = sPostzon.Split(",")
                Dim sPostcode As String = fldsPostzon(0)

                ' Convert grid references to metres
                Dim nEast As Integer = 0, nNorth As Integer = 0
                Dim lng As Double = 0.0, lat As Double = 0.0
                Dim bGridOK As Boolean = GetLocation(sPostcode, fldsPostzon(1), fldsPostzon(2), nEast, nNorth, lng, lat)

                ' Output position
                If bGridOK Then
                    .WriteElementString("LNG", lng.ToString("F7"))
                    .WriteElementString("LAT", lat.ToString("F7"))
                    .WriteElementString("GRE", nEast.ToString())
                    .WriteElementString("GRN", nNorth.ToString())
                End If

                ' Output Local Authority codes
                Dim sAuthCodes As String = fldsPostzon(6) + fldsPostzon(7) + fldsPostzon(8)
                Dim sCounty As String = "", sDistrict As String = "", sWardName As String = ""
                Dim cCountry As Char = ""
                If sAuthCodes <> "" Then
                    AddressObject.WardData(sAuthCodes, sCounty, sDistrict, sWardName, cCountry)
                End If

                If (fldsPostzon(6) <> "") Then
                    .WriteElementString("CCD", fldsPostzon(6))
                    If sCounty <> "" Then
                        .WriteElementString("CNM", sCounty)
                    End If
                End If
                If (fldsPostzon(7) <> "") Then
                    If (fldsPostzon(6) <> "") Then
                        .WriteElementString("DCD", fldsPostzon(7))
                        If sDistrict <> "" Then
                            .WriteElementString("DNM", sDistrict)
                        End If
                    Else
                        .WriteElementString("UCD", fldsPostzon(7))
                        If sDistrict <> "" Then
                            .WriteElementString("UNM", sDistrict)
                        End If
                    End If
                End If
                If (fldsPostzon(8) <> "") Then
                    .WriteElementString("WCD", fldsPostzon(8))
                    If sWardName <> "" Then
                        .WriteElementString("WNM", sWardName)
                    End If
                End If

                ' Output NHS and Sort Code
                If (fldsPostzon(4) <> "") Then .WriteElementString("NHS", fldsPostzon(4))
                If (fldsPostzon(5) <> "") Then .WriteElementString("SCD", fldsPostzon(5))

                ' Output postcode
                .WriteElementString("PCD", sPostcode)

            End If

            ' Finish writing
            .WriteEndElement()
            .WriteEndDocument()
            .Close()

        End With

    End Sub

    Public Sub JSONPostzon(ByRef AddressObject As AddressUKNET.Address, ByVal sPostzon As String)
        ' Output a JSON structure of Postzon details 

        ' Create a TextWriter instance
        Response.ContentType = "application/json"
        Dim twsJSON As TextWriter = New StreamWriter(Response.OutputStream)

        ' Write opening lines
        With twsJSON
            .Write("{" + vbCrLf)
            .Write(" ""Result"":" + vbCrLf)
            .Write(" {" + vbCrLf)

            ' Split up data elements
            If sPostzon <> "" Then

                Dim fldsPostzon As String() = sPostzon.Split(",")
                Dim sPostcode As String = fldsPostzon(0)

                ' Convert grid references to metres
                Dim nEast As Integer = 0, nNorth As Integer = 0
                Dim lng As Double = 0.0, lat As Double = 0.0
                Dim bGridOK As Boolean = GetLocation(sPostcode, fldsPostzon(1), fldsPostzon(2), nEast, nNorth, lng, lat)

                ' Output position
                If bGridOK Then
                    .Write(" ""LNG"": """ + lng.ToString("F7") + """," + vbCrLf)
                    .Write(" ""LAT"": """ + lat.ToString("F7") + """," + vbCrLf)
                    .Write(" ""GRE"": """ + nEast.ToString() + """," + vbCrLf)
                    .Write(" ""GRN"": """ + nNorth.ToString() + """," + vbCrLf)
                End If

                ' Output Local Authority codes
                Dim sAuthCodes As String = fldsPostzon(6) + fldsPostzon(7) + fldsPostzon(8)
                Dim sCounty As String = "", sDistrict As String = "", sWardName As String = ""
                Dim cCountry As Char = ""
                If sAuthCodes <> "" Then
                    AddressObject.WardData(sAuthCodes, sCounty, sDistrict, sWardName, cCountry)
                End If

                If (fldsPostzon(6) <> "") Then
                    .Write(" ""CCD"": """ + fldsPostzon(6) + """," + vbCrLf)
                    If sCounty <> "" Then
                        .Write(" ""CNM"": """ + sCounty + """," + vbCrLf)
                    End If
                End If
                If (fldsPostzon(7) <> "") Then
                    If (fldsPostzon(6) <> "") Then
                        .Write(" ""DCD"": """ + fldsPostzon(7) + """," + vbCrLf)
                        If sDistrict <> "" Then
                            .Write(" ""DNM"": """ + sDistrict + """," + vbCrLf)
                        End If
                    Else
                        .Write(" ""UCD"": """ + fldsPostzon(7) + """," + vbCrLf)
                        If sDistrict <> "" Then
                            .Write(" ""UNM"": """ + sDistrict + """," + vbCrLf)
                        End If
                    End If
                End If
                If (fldsPostzon(8) <> "") Then
                    .Write(" ""WCD"": """ + fldsPostzon(8) + """," + vbCrLf)
                    If sWardName <> "" Then
                        .Write(" ""WNM"": """ + sWardName + """," + vbCrLf)
                    End If
                End If


                ' Output NHS and Sort Code
                If (fldsPostzon(4) <> "") Then .Write(" ""NHS"": """ + fldsPostzon(4) + """," + vbCrLf)
                If (fldsPostzon(5) <> "") Then .Write(" ""SCD"": """ + fldsPostzon(5) + """," + vbCrLf)

                ' Output postcode
                .Write(" ""PCD"": """ + sPostcode + vbCrLf)

            End If

            ' Finish writing
            .Write(" }" + vbCrLf)
            .Write("}" + vbCrLf)
            .Close()

        End With

    End Sub

    Private Function GetLocation(ByVal sPostcode As String, ByVal sEasting As String, ByVal sNorthing As String, _
                    ByRef nEast As Integer, ByRef nNorth As Integer, ByRef lng As Double, ByRef lat As Double) As Boolean
        ' Convert string representation of Eastings and Northings to integer. Derive latitude/longitude.

        ' Initialise
        ' Initialise the address object
        Dim MapObject As AddressUKNET.Mapping = New AddressUKNET.Mapping()
        Try
            MapObject = New AddressUKNET.Mapping()
        Catch
            '   nErrNo = 104
        End Try
        nEast = 0
        nNorth = 0
        lng = 0.0
        lat = 0.0
        Dim bOK As Boolean = False
        If (sEasting <> "") And (sNorthing <> "") Then

            ' Convert to integer
            Try
                nEast = Convert.ToInt32(sEasting)
                nNorth = Convert.ToInt32(sNorthing)
                If (nEast > 0) And (nNorth > 0) Then
                    bOK = True
                End If
            Catch
                nEast = 0
                nNorth = 0
            End Try

            ' Derive latitude/longitude
            If bOK Then
                Dim nGrid As Integer = 1
                If sPostcode.Substring(0, 2) = "BT" Then nGrid = 2
                bOK = MapObject.GeoRefConvert(nGrid, nEast, nNorth, 5, lng, lat)
            End If
        End If

        ' Return status
        Return bOK

    End Function

    Public Sub XMLDebug(ByVal sMess As String)
        ' Output an XML file with a debug message

        ' Create a new XmlTextWriter instance
        Dim XmlWriter As XmlTextWriter = New XmlTextWriter(Response.OutputStream, Encoding.UTF8)

        With XmlWriter
            .WriteStartDocument()
            .WriteStartElement("Result")
            .WriteElementString("Debug", sMess)
            .WriteEndElement()
            .WriteEndDocument()
            .Close()
        End With

    End Sub

    Public Sub SendEmail(ByRef MyConn As OleDbConnection, ByVal sUser As String, ByVal sPassword As String, ByVal func As fnType)
        ' Send an email warning that clicks are getting low

        ' Load Client name and eMail address 
        Dim sql As String = "SELECT ClientName, eMail FROM UserData WHERE UserName = '" & sUser & "' AND Password = '" & sPassword & "'"
        Dim cmd As New OleDbCommand(sql, MyConn)
        Dim sEmail As String = "", sClient As String = ""
        Try
            Dim r As OleDbDataReader = cmd.ExecuteReader()
            r.Read()
            sClient = r.Item("ClientName")
            sEmail = r.Item("eMail")
        Catch
            sEmail = ""
        End Try
        cmd.Dispose()

        If sEmail <> "" Then

            ' Find type of clicks getting low
            Dim sFunction As String = ""
            Select Case func
                Case fnType.ROAD_LEVEL
                    sFunction = "road-level"
                Case fnType.PREMISE_LEVEL
                    sFunction = "premise-level"
                Case fnType.POSTZON
                    sFunction = "Postzon"
            End Select

            ' Set up email client
            Dim SmtpMail As New Net.Mail.SmtpClient

            ' Assemble message
            Dim MessageBody As String = _
                "WARNING:" & vbCrLf & vbCrLf & "Your credits for " + sFunction + " pay-as-you-go address lookups are getting low." & vbCrLf & _
                "User name: " & sUser & vbCrLf & _
                "Contact Arc en Ciel Ltd on 020 7281 9885 to top up your account."

            Try
                ' Send the email to the client & a copy to us
                SmtpMail.Send("info@arcenciel.com", sEmail, "Address lookup credits low", MessageBody)
                SmtpMail.Send("mail@addressgeo.co.uk", "info@arcenciel.com", sClient + " Warning email", MessageBody)

            Catch
                'Cannot send e-mail

            End Try

        End If

    End Sub

End Class


